home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / mouse.swg / 0011_Mouse Library.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-02  |  6.1 KB  |  175 lines
  1. {
  2. From: LOU DUCHEZ
  3. Subj: mouse Library
  4. }
  5.  
  6. unit mouse;
  7. interface                                 { "Global" declarations }
  8. var mouseexist, mousecursoron: boolean;   { Is a mouse hooked up? / Is the    }
  9. procedure mouseinit;                      {   mouse cursor "on"?              }
  10. procedure mouseon;
  11. procedure mouseoff;
  12. function mousex: word;                    { Note about coordinates: these     }
  13. function mousey: word;                    {  routines return values starting  }
  14. function mouseleft: boolean;              {  at 0, not 1 (even in text mode). }
  15. function mousemiddle: boolean;            {  So for text mode, you may want   }
  16. function mouseright: boolean;             {  to modify a bit ...              }
  17. procedure setmousexy(newx, newy: word);
  18. procedure limitmouse(lox, loy, hix, hiy: word);
  19.  
  20.  
  21. implementation                            { internal workings }
  22. uses dos;
  23. var regs: registers;                      { Used for the "mouse" interrupts }
  24.     xshift, yshift: byte;                 { Depending on your video mode, you }
  25.                                           {  may need to convert "mouse"      }
  26.                                           {  coordinates to / from "video"    }
  27. procedure calcshifts;                     {  coordinates.  It's a matter of   }
  28. var tempregs: registers;                  {  shifting left/right; xshift      }
  29. begin                                     {  records how to shift the "X",    }
  30.   tempregs.ah := $0f;                     {  and yshift records for the "Y".  }
  31.   intr($10, tempregs);                    { Procedure CalcShifts figures out  }
  32.   case tempregs.al of                     {  what text mode you're in and how }
  33.     0, 1, 2, 3, 7: begin                  {  much to shift by.  It gets the   }
  34.       xshift := 3;                        {  video mode w/interrupt $10/$0f;  }
  35.       yshift := 3;                        {  modes 0, 1, 2, 3 and 7 are text  }
  36.       end;                                {  modes.  4, 5, $0d and $13 are    }
  37.     4, 5, $0d, $13: begin                 {  320 x 200 graphics modes.  All   }
  38.       xshift := 1;                        {  other graphics modes are okay    }
  39.       yshift := 0;                        {  "as is", although come to think  }
  40.       end;                                {  of it I had a CGA system when I  }
  41.     else begin                            {  wrote this library and thus      }
  42.       xshift := 0;                        {  couldn't text VGA modes ...      }
  43.       yshift := 0;
  44.       end;
  45.     end;
  46.   end;
  47.  
  48.  
  49. procedure mouseinit;                  { Initializes mouse -- determines if   }
  50. begin                                 { one is present, then figures out the }
  51.   regs.ax := $0000;                   { shifts, and initializes the "cursor" }
  52.   intr($33, regs);                    { variable to "false". }
  53.   mouseexist := (regs.ax = $FFFF);
  54.   if mouseexist then calcshifts;      { Called automatically on startup; you }
  55.   mousecursoron := false;             { should call it if you change video   }
  56.   end;                                { modes in the program. }
  57.  
  58.  
  59. procedure mouseon;                    { Turns cursor ON. }
  60. begin
  61.   if mouseexist then begin            { Note: you really should "pair" each }
  62.     regs.ax := $0001;                 {  "on" with an "off"; if you don't,  }
  63.     intr($33, regs);                  {  the PC can get confused. }
  64.     mousecursoron := true;
  65.     end;
  66.   end;
  67.  
  68.  
  69. procedure mouseoff;                   { Turns cursor OFF.  Note: when writing }
  70. begin                                 {  to the screen, you typically want to }
  71.   if mouseexist then begin            {  turn the cursor OFF: the PC isn't    }
  72.     regs.ax := $0002;                 {  smart enough to say, "I'm writing a  }
  73.     intr($33, regs);                  {  character right where the mouse      }
  74.     mousecursoron := false;           {  cursor is: better make it inverse    }
  75.     end;                              {  video".  So you need to shut it off. }
  76.   end;
  77.  
  78.  
  79. function mousex: word;                { Gets the current mouse column. }
  80. var tempword: word;
  81. begin
  82.   if mouseexist then begin
  83.     regs.ax := $0003;
  84.     intr($33, regs);
  85.     tempword := regs.cx;
  86.     end
  87.    else
  88.     tempword := 0;
  89.   mousex := tempword shr xshift;      { one of those funky "shift" things }
  90.   end;
  91.  
  92. function mousey: word;                { Gets the current mouse row. }
  93. var tempword: word;
  94. begin
  95.   if mouseexist then begin
  96.     regs.ax := $0003;
  97.     intr($33, regs);
  98.     tempword := regs.dx;
  99.     end
  100.    else
  101.     tempword := 0;
  102.   mousey := tempword shr yshift;
  103.   end;
  104.  
  105.  
  106. function mouseleft: boolean;      { Is the left button down? }
  107. var tempword: word;
  108. begin
  109.   if mouseexist then begin
  110.     regs.ax := $0003;
  111.     intr($33, regs);
  112.     tempword := regs.bx;
  113.     end
  114.    else
  115.     tempword := 0;
  116.   mouseleft := mouseexist and (1 and tempword = 1);
  117.   end;
  118.  
  119.  
  120. function mousemiddle: boolean;    { Is the middle button down? }
  121. var tempword: word;
  122. begin
  123.   if mouseexist then begin
  124.     regs.ax := $0003;
  125.     intr($33, regs);
  126.     tempword := regs.bx;
  127.     end
  128.    else
  129.     tempword := 0;
  130.   mousemiddle := mouseexist and (4 and tempword = 4);
  131.   end;
  132.  
  133.  
  134. function mouseright: boolean;     { Is the right button down? }
  135. var tempword: word;
  136. begin
  137.   if mouseexist then begin
  138.     regs.ax := $0003;
  139.     intr($33, regs);
  140.     tempword := regs.bx;
  141.     end
  142.    else
  143.     tempword := 0;
  144.   mouseright := mouseexist and (2 and tempword = 2);
  145.   end;
  146.  
  147.  
  148. procedure setmousexy(newx, newy: word);   { Position mouse cursor. }
  149. begin
  150.   regs.ax := $0004;
  151.   regs.cx := newx shl xshift;             { Shifts to get it into "mouse" }
  152.   regs.dx := newy shl yshift;             {  coordinates. }
  153.   intr($33, regs);
  154.   end;
  155.  
  156.  
  157. procedure limitmouse(lox, loy, hix, hiy: word);   { Restrict mouse movements. }
  158. begin
  159.   regs.ah := $0f;
  160.   intr($10, regs);
  161.   regs.ax := $0007;
  162.   regs.cx := lox shl xshift;
  163.   regs.dx := hix shl xshift;
  164.   intr($33, regs);
  165.   regs.ax := $0008;
  166.   regs.cx := loy shl yshift;
  167.   regs.dx := hiy shl yshift;
  168.   intr($33, regs);
  169.   end;
  170.  
  171.  
  172. begin                 { Startup code: initializes mouse and gets video mode. }
  173.   mouseinit;
  174.   end.
  175.